#!/usr/bin/perl -c

package PIPL::Configuration;
use 5.006;
our $VERSION = '0.01';

=head1 NAME

PIPL::Configuration - Access to configuration files

=head1 SYNOPSIS

  use PIPL::Configuration;
  $file = '/etc/pi/main.yml';
  $default_data = { 'key1' => 'val1', 'key2' => 'val2' };
  $c = PI::Configuration->new(file=>$file, default_data=>$default_data);

  $c->load;
  print $c->{data}->{default_area};
  $c->{data}->{area}->{home} = '/usr/local';
  $c->save;

=head1 DESCRIPTION

This class maintains PI's configuration files and handles lock files. It is a
base class for real configuration classes.

=cut


use strict;

use base 'PIPL::File::Lock';


use PIPL::System::Config;
use PIPL::System::Env;
use PIPL::System::Path;

use PIPL::Configuration::Path;

use Exception::Base
    'Exception::PIPL::Configuration' => {
        isa => 'Exception::System' };

use File::Spec;
use YAML;


# List of class fields (name => {is=>ro|rw, default=>value})
use constant FIELDS => {
    %{ PIPL::File::Lock->FIELDS },
    data         => { is => 'rw' },
    default_data => { is => 'rw' },
};


# Load the configuration file
sub load {
    my $self = shift;
    my $file = shift || $self->{file};

    $self->lock;

    if (-f $self->{file}) {
        $self->{data} = YAML::LoadFile($file);
    }
    else {
        $self->{data} = $self->clone($self->{default_data});
    }

    return $self->unlock;
}


# Save the configuration file
sub save {
    my $self = shift;
    my $file = shift || $self->{file};

    my $tmpfile = $file."-$$";
    my $oldfile = "$file~";
    my $ancient_backup = $file.".bak.".$$;

    $self->lock;

    local $SIG{INT} = sub { warn "Please hold on a moment. PI is writing out a critical configuration file.\n"};

    #local $YAML::UseHeader = 0;
    YAML::DumpFile($tmpfile, $self->{data});

    if (not -f $tmpfile ) {
        throw Exception::PIPL::Configuration
            message=>"Couldn't write your new configuration file to $tmpfile. Please try again.";
    }

    if (-f $oldfile ) {
        rename $oldfile => $ancient_backup
            or throw Exception::PIPL::Configuration
                message=>"Couldn't remove your old backup configuration file $oldfile while writing the new one.";
    }
    if (-f $file ) {
        rename $file => $oldfile
            or throw Exception::PIPL::Configuration
                message=>"Couldn't remove your old configuration file $file while writing the new one.";
    }

    rename $tmpfile => $file
        or throw Exception::PIPL::Configuration
            message=>"Couldn't write your new configuration file $file. A backup has been stored in $tmpfile. Please replace $file with $tmpfile immediately.";

    if (-f $ancient_backup ) {
        unlink $ancient_backup
            or throw Exception::PIPL::Configuration
                message=>"Couldn't remove your old backup configuration file $oldfile while writing the new one.";
    }

    return $self->unlock;
}


1;


=head1 BASE CLASSES

=over 2

=item *

L<PIPL::File::Lock>

=back

=head1 FIELDS

=over

=item data (rw)

Contains the data of configuration file.

=item default_data (rw)

Contains the default data of configuration file.  It is used if the
configuration file can not be loaded.

=item file (rw)

=item lock_file (ro)

=item locked (ro)

See L<PIPL::File::Lock>.

=back

=head1 CONSTRUCTORS

=over

=item new

Creates the configuration file object for the given I<file>.  If the file can
not be loaded, the I<default_data> will be used as configuration data.

=back

=head1 METHODS

=over

=item load([I<$file>])

Loads the configuration file. If the file can not be loaded, the default data
will be used as configuration data.  The I<$file> argument is optional and
the default B<file> attribute will be used as default.

TODO: Jeli cieka wzgldna - przy load wczytaj pierwszy znaleziony.

=item save([I<$file>])

Saves the configuration file.  The I<$file> argument is optional and the
default B<file> attribute will be used as default.

TODO: Jeli cieka wzgldna - przy save zapisz do pierwszej rw cieki.

TODO: If the configuration directory does not exist at any path, the configuration
directory is created at first location which is writable or dies if any
location is not writable.

=item lock

=item unlock

See L<PIPL::File::Lock>.

=back

=head1 SEE ALSO

L<PIPL::File::Lock>, L<PIPL::Class::Base>.

=head1 AUTHORS

Piotr Roszatycki E<lt>dexter@debian.orgE<gt>

=head1 COPYRIGHT

Copyright 2006-2007 by Piotr Roszatycki E<lt>dexter@debian.orgE<gt>.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

See L<http://www.perl.com/perl/misc/Artistic.html>
